home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1995 November
/
EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso
/
earcd
/
util
/
text
/
xes.lha
/
XES
/
REXX
/
RenumberOutline.xdme
< prev
next >
Wrap
Text File
|
1995-08-01
|
3KB
|
137 lines
/* $VER: RenumberOutline.xdme 1.0 (01 Aug 1995) */
/* Copyright © 1995 Fergus Duniho */
/* Renumbers Blocked Portion of an Outline */
'goto end if b downadd'
bsave 'ram:text'
'title `Renumbering -\Please Wait!'
Call Open 'Old','RAM:TEXT','R'
Call Open 'New','RAM:TEXT2','W'
Do X = 1 to 8
H.X = ''
End
LINE = Readln('Old')
Call Writeln 'New',LINE
LN = 0
POSITION = Verify(LINE,'.)',m)
LV = (POSITION - 9)%4 + 1
H.LV = Word(LINE,1)
DO FOREVER
DO UNTIL LINE = ''
LINE = Readln('Old')
CALL Writeln 'New',LINE
LN = LN + 1
END
LINE = Readln('Old')
IF EOF('Old') THEN LEAVE
LN = LN + 1
PS = Verify(LINE,'.)',m)
IF PS = 0 THEN LEAVE
H.LV = Left(H.LV,Length(H.LV)-1)
LEVEL = LV
LV = (PS - 9)%4 + 1
HD = Word(LINE,1)
IF LEVEL >= LV THEN
IF H.LV ~= '' THEN DO
SELECT
WHEN LV = 1 THEN H.LV = UPPER(Roman(Arabic(H.LV) + 1))
WHEN LV = 2 | LV = 5 | LV = 8 THEN H.LV = d2c(c2d(H.LV) + 1)
WHEN LV = 3 | LV = 6 THEN H.LV = H.LV + 1
WHEN LV = 4 | LV = 7 THEN H.LV = (Roman(Arabic(H.LV) + 1))
OTHERWISE NOP
END
H.LV = H.LV || Right(HD,1)
END
ELSE H.LV = HD
ELSE IF LEVEL = LV - 1 THEN DO
SELECT
WHEN LEVEL = 1 THEN H.LV = 'A.'
WHEN LEVEL = 2 THEN H.LV = '1.'
WHEN LEVEL = 3 THEN H.LV = 'i.'
WHEN LEVEL = 4 THEN H.LV = 'a.'
WHEN LEVEL = 5 THEN H.LV = '1)'
WHEN LEVEL = 6 THEN H.LV = 'i)'
WHEN LEVEL = 7 THEN H.LV = 'a)'
OTHERWISE NOP
END
END
ELSE DO
goto block
Com = 'goto +'LN
Com
firstnb
'set RS `Error !!!'
EXIT
END
LINE = Copies(' ',Ps - (Length(H.LV))) || H.LV " " Subword(LINE, 2)
CALL Writeln 'New',LINE
END
CALL Close ('Old')
CALL Close ('New')
bdelete
'set RS `Renumbering Successful'
insfile 'ram:text2'
EXIT
/* Converts an Arabic Numeral to a Roman Numeral */
Roman: Procedure
ARG A
R = word("i ii iii iv v vi vii viii ix",A//10)
A = A % 10
IF A > 0 THEN DO
R = Word("x xx xxx xl l lx lxx lxxx xc",A//10) || R
A = A % 10
END
IF A > 0 THEN DO
R = Word("c cc ccc cd d dc dcc dccc cm",A//10) || R
A = A % 10
END
IF A > 0 THEN R = Word("m mm mmm",A) || R
RETURN R
/* Converts a Roman numeral to an Arabic numeral */
Arabic: Procedure
Arg ROMAN
A = 0
DO P = 1 to Length(ROMAN)
L = Substr(ROMAN,P,1)
R = Delstr(ROMAN,1,P)
SELECT
WHEN L = 'M' Then A = A + 1000
WHEN L = 'D' Then A = A + 500
WHEN L = 'C' Then If Verify(R,'MD','M')>0 THEN
A = A - 100
ELSE
A = A + 100
WHEN L = 'L' Then A = A + 50
WHEN L = 'X' Then If Verify(R,'CL','M')>0 THEN
A = A - 10
ELSE
A = A + 10
WHEN L = 'V' Then A = A + 5
WHEN L = 'I' Then If Verify(R,'XV','M')>0 THEN
A = A - 1
ELSE
A = A + 1
OTHERWISE NOP
END
END
RETURN A